home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / error_hn / rdblib / rbscrn.frm < prev    next >
Text File  |  1995-04-09  |  3KB  |  108 lines
  1. VERSION 2.00
  2. Begin Form RBScrn
  3. BorderStyle     =   0  'None
  4. Caption         =   "Current Screen Print"
  5. ClientHeight    =   4020
  6. ClientLeft      =   1095
  7. ClientTop       =   1485
  8. ClientWidth     =   7365
  9. ControlBox      =   0   'False
  10. Height          =   4425
  11. Left            =   1035
  12. LinkTopic       =   "Form2"
  13. MaxButton       =   0   'False
  14. MinButton       =   0   'False
  15. MousePointer    =   11  'Hourglass
  16. ScaleHeight     =   4020
  17. ScaleWidth      =   7365
  18. Top             =   1140
  19. Width           =   7485
  20. WindowState     =   2  'Maximized
  21. Begin PictureBox Picture1
  22. AutoRedraw      =   -1  'True
  23. BorderStyle     =   0  'None
  24. Height          =   4035
  25. Left            =   0
  26. ScaleHeight     =   4035
  27. ScaleWidth      =   7395
  28. TabIndex        =   0
  29. Top             =   0
  30. Visible         =   0   'False
  31. Width           =   7395
  32. End
  33. End
  34. Dim ljunk As Integer
  35.  
  36. Sub Form_Activate ()
  37.     mousepointer = HOURGLASS
  38.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_HIDE)
  39.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_HIDE)
  40.     ljunk = ShowWindow(RBScrn.hWnd, SW_HIDE)
  41.     DoEvents
  42.     mousepointer = HOURGLASS
  43.     GrabScreen
  44.  
  45.     mousepointer = HOURGLASS
  46.     ljunk = ShowWindow(RBScrn.hWnd, SW_SHOW)
  47.     RBScrn.WindowState = MAXIMIZED
  48.     DoEvents
  49.     RBScrn.PrintForm
  50.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_SHOW)
  51.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_SHOW)
  52.     Unload RBScrn
  53.  
  54. End Sub
  55.  
  56. Sub GetTwipsPerPixel ()
  57.     ' Set a global variable with the Twips to Pixel ratio.
  58.     RBScrn.ScaleMode = 3
  59.     NumPix = RBScrn.ScaleHeight
  60.     RBScrn.ScaleMode = 1
  61.     TwipsPerPixel = RBScrn.ScaleHeight / NumPix
  62. End Sub
  63.  
  64. Sub GrabScreen ()
  65.  
  66.     Dim winSize As lrect
  67.  
  68.     ' Assign information of the source bitmap.
  69.     ' Note that BitBlt requires coordinates in pixels.
  70.     hwndSrc% = GetDesktopWindow()
  71.     hSrcDC% = GetDC(hwndSrc%)
  72.     XSrc% = 0: YSrc% = 0
  73.     Call GetWindowRect(hwndSrc%, winSize)
  74.     nWidth% = winSize.right             ' Units in pixels.
  75.  
  76.     nHeight% = winSize.bottom           ' Units in pixels.
  77.  
  78.     ' Assign informate of the destination bitmap.
  79.     hDestDC% = RBScrn.Picture1.hDC
  80.     x% = 0: Y% = 0
  81.  
  82.     ' Set global variable TwipsPerPixel and use to set
  83.     ' picture box to same size as screen being grabbed.
  84.     ' If picture box not the same size as picture being
  85.     ' BitBlt'ed to it, it will chop off all that does not
  86.     ' fit in the picture box.
  87.     GetTwipsPerPixel
  88.     RBScrn.Picture1.Top = 0
  89.     RBScrn.Picture1.Left = 0
  90.     RBScrn.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
  91.     RBScrn.Picture1.Height = (nHeight% + 1) * TwipsPerPixel
  92.  
  93.     ' Assign the value of the constant SRCOPYY to the Raster operation.
  94.  
  95.     dwRop& = &HCC0020
  96.  
  97.     ' Note function call must be on one line:
  98.     Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)
  99.  
  100.     ' Release the DeskTopWindow's hDC to Windows.
  101.     ' Windows may hang if this is not done.
  102.     Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
  103.  
  104.     'Make the picture box visible.
  105.     RBScrn.Picture1.Visible = True
  106. End Sub
  107.  
  108.